home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 011 / clrprmpt.arc / COLORFIX < prev    next >
Encoding:
Text File  |  1988-05-19  |  10.8 KB  |  308 lines
  1.  
  2.  - NOTE -
  3.  
  4.  Lines that have 'DGSC at the end of them are new lines that must be
  5.  added.
  6.  
  7.  Lines that have 'DGSCMOD at the end of them are Modified lines that
  8.  must be changed.
  9.  
  10.  Lines with dashes before and after them do not get added into the code
  11.  
  12.  - RBBS-PC.BAS -
  13.  
  14.  - If the sysop chooses in the config to not allow new users to set -
  15.  - their defaults this code will turn the users colors off.         -
  16.  
  17. 760 ....
  18.     ....
  19.     ELSE UPPER.CASE = FALSE : _
  20.          GR = 0 : _
  21.          USER.PROMPT.CODE$=STRING$(4,29) : _        'DGSC
  22.          USER.GRAPHIC.DEFAULT$ = " " : _
  23.  
  24.  
  25.   - These two lines allow users that have been registered before this code -
  26.   - is implemented to be asked if they want a color prompt.                -
  27.  
  28.  
  29. 817 IF REMIND.FILE.TRANSFERS AND NOT NEW.USER THEN _
  30.        A$ = "Files Downloaded:" + _
  31.             STR$(DOWNLOADS) + _
  32.             "  Uploaded:" + _
  33.             STR$(UPLOADS) : _
  34.        GOSUB 12977
  35.     IF REMIND.PROFILE THEN _
  36.        GOSUB 5400 : _
  37.     CALL MOREYN (FALSE)
  38.     IF ASC(LEFT$(USER.PROMPT.CODE$,1))=0 AND NOT NEW.USER THEN _  'DGSC
  39.        CALL CPRMPT(USER.PROMPT.CODE$)                             'DGSC
  40.  
  41.  
  42.  - This is the logic that sets up the users prompt with colors if wanted -
  43.  
  44. 1295 ACTIVE.MENU$ = LEFT$(SECTION$,1)
  45.      USE.CLR.PROMPT=FALSE                          'DGSC
  46.      IF LEFT$(CLR.PROMPT.CODE$,1)> CHR$(29) THEN   'DGSC
  47.         USER.PROMPT.CODE$=CLR.PROMPT.CODE$         'DGSC
  48.      END IF                                        'DGSC
  49.      IF LEFT$(USER.PROMPT.CODE$,1)> CHR$(29) THEN  'DGSC
  50.         FOR ARYNUM=1 TO 4                          'DGSC
  51.            USER.CLR$(ARYNUM)=STR$(ASC(MID$(USER.PROMPT.CODE$,ARYNUM,1))) 'DGSC
  52.            IF USER.CLR$(ARYNUM)=" 30" THEN                               'DGSC
  53.               USER.CLR$(ARYNUM)="0"                                      'DGSC
  54.            ELSE USER.CLR$(ARYNUM)=RIGHT$(USER.CLR$(ARYNUM),2)            'DGSC
  55.            END IF                                                        'DGSC
  56.            USER.CLR$(ARYNUM)=CHR$(27)+"[1;"+USER.CLR$(ARYNUM)+"m"        'DGSC
  57.            USE.CLR.PROMPT=TRUE                     'DGSC
  58.         NEXT ARYNUM                                'DGSC
  59.      END IF                                        'DGSC
  60.      IF SHOW.SECTION THEN _
  61.         SECTION.PROMPT$ = SECTION$ _
  62.      ELSE SECTION.PROMPT$ = "Your"
  63.      IF COMMANDS.IN.PROMPT=0 THEN _
  64.          SECTION.OPTS$ = ""
  65.      CLR.PROMPT.CODE$=USER.PROMPT.CODE$                    'DGSC
  66.      IF USE.CLR.PROMPT THEN                                'DGSC
  67.         COMMAND.PROMPT$ = USER.CLR$(1)+SECTION.PROMPT$ + _ 'DGSC
  68.                           USER.CLR$(2)+" Command" + _      'DGSC
  69.                           USER.CLR$(3)+SECTION.OPTS$ + _   'DGSC
  70.                           USER.CLR$(4)                     'DGSC
  71.      ELSE                                                  'DGSC
  72.         COMMAND.PROMPT$ = SECTION.PROMPT$ + _
  73.                           " Command" + _
  74.                           SECTION.OPTS$
  75.      END IF                                                'DGSC
  76.      RETURN
  77.  
  78.  
  79.  - This is needed to correct problem of sysops colors being set to -
  80.  - green when saving a message.                                    -
  81.  
  82. 3640 GOSUB 12979
  83.      LSET MESSAGE.RECORD$ = MESSAGE.RECORD.SAVE$
  84.      GOSUB 24000
  85.      GOSUB 12985
  86. 3650 IF REPLY AND DGS.REFR.ABORT = 0 THEN _                    'DGS
  87.         CALL REFRA (HIGH.MESSAGE.NUMBER,CURRENT.MESSAGE,GRN$)  'DGS
  88.      DGS.REFR.ABORT = 0                                        'DGS
  89.      IF REPLY THEN _                                           'DGSMOD
  90.         REPLY = FALSE : _
  91.         GOTO 5344
  92.      IF SYSOP THEN USER.PROMPT.CODE$=CLR.PROMPT.CODE$          'DGSC
  93.      RETURN 1200
  94.  
  95.  
  96.  - Definition of Fields -
  97.  
  98. 9450 IF LOF(5) < 1 THEN _
  99.         DF$ = ACTIVE.USER.FILE$ : _
  100.         RETURN 13600
  101.      FIELD 5,31 AS USER.NAME$, _
  102.              15 AS PASSWORD$, _
  103.               2 AS SECURITY.LEVEL$, _
  104.              14 AS USER.OPTIONS$,  _
  105.              24 AS CITY.STATE$, _
  106.              15 AS MACHINE.TYPE$, _                           'DGSCMOD
  107.               4 AS USER.PROMPT.CODE$, _                       'DGSC
  108.              14 AS LAST.DATE.TIME.ON$, _
  109.               3 AS LIST.NEW.DATE$, _
  110.               2 AS USER.DOWNLOADS$, _
  111.               2 AS USER.UPLOADS$, _
  112.               2 AS ELAPSED.TIME$
  113.      FIELD 5,128 AS USER.RECORD$
  114.      RETURN
  115.  
  116.  
  117.  - Call Subroutine CPRMPT whenever Graphics option is selected -
  118.  
  119. 43007 A$ = "GRAPHICS wanted: [N]one, A)scii-IBM, C)olor-IBM, H)elp"
  120.       GOSUB 12995
  121.       IF Q = 0 THEN _
  122.          B$(1) = "N"
  123.       CALL ALLCAPS (B$(1))
  124.       GR = INSTR("NAC",B$(1))
  125.       IF GR = 0 THEN _
  126.          GOTO 43006
  127.       CALL CPRMPT(CLR.PROMPT.CODE$)                 'DGSC
  128.       GOSUB 1295                                    'DGSC
  129.       USER.GRAPHIC.DEFAULT$ = MID$(" GC",GR, - (GR > 1))
  130.       GR = GR - 1
  131.  
  132.  - RBBSSUB1.BAS -
  133.  
  134.  - Field Definitions -
  135.  
  136. ' ***********************************************
  137. ' * OPEN AND DEFINE USER FILE RECORD VARIABLES
  138. ' ***********************************************
  139. '
  140. 9400 CLOSE 5
  141.      IF SHARE.IT THEN _
  142.         OPEN ACTIVE.USER.FILE$ FOR RANDOM SHARED AS #5 LEN=128 _
  143.      ELSE OPEN "R",5,ACTIVE.USER.FILE$,128
  144.      I# = LOF(5)
  145.      LAST.REC = FIX(I#/128)
  146.      FIELD 5,31 AS USER.NAME$, _
  147.              15 AS PASSWORD$, _
  148.               2 AS SECURITY.LEVEL$, _
  149.              14 AS USER.OPTIONS$,  _
  150.              24 AS CITY.STATE$, _
  151.              15 AS MACHINE.TYPE$, _                           'DGSCMOD
  152.               4 AS USER.PROMPT.CODE$, _                       'DGSC
  153.              14 AS LAST.DATE.TIME.ON$, _
  154.               3 AS LIST.NEW.DATE$, _
  155.               2 AS USER.DOWNLOADS$, _
  156.               2 AS USER.UPLOADS$, _
  157.               2 AS ELAPSED.TIME$
  158.      FIELD 5,128 AS USER.RECORD$
  159.      END SUB
  160.  
  161.  
  162.  - This Sub-Routine goes in RBBSSUB1.BAS before - Error Handling for  -
  163.  -                                                separately compiled -
  164.  -                                                subroutines         -
  165.  
  166.  
  167. ' $SUBTITLE: 'CPRMPT - GET USER PROMPT COLORS'
  168. ' $PAGE
  169. '
  170. '  SUBROUTINE NAME   -- CPRMPT
  171. '
  172. '  INPUT PARAMETERS  --  PARAMETER            MEANING
  173. '
  174. '                        CLR.PROMPT.CODE$   USERS COLOR SELECTIONS
  175. '
  176. '  OUTPUT PARAMETERS  -- CLR.PROMPT.CODE$   USERS COLOR SELECTIONS
  177. '
  178. '  SUBROUTINE PURPOSE -- GET SELECTIONS FROM USER FOR COLOR PROMPT IF WANTED
  179. '
  180.       SUB CPRMPT(CLR.PROMPT.CODE$) STATIC
  181.       FILE.NAME$="CLRPRMPT.DEF"
  182.       CALL FINDIT(FILE.NAME$)
  183.       IF NOT OK THEN EXIT SUB
  184.       A$="Would you like to set the Colors of your Prompt [Y]/N"
  185.       SUBROUTINE.PARAMETER=1
  186.       CALL TGET
  187.       IF NO THEN
  188.          CALL QTPUT(CHR$(27)+"[0m",1)
  189.          USER.PROMPT.CODE$=STRING$(4,29)
  190.          CLR.PROMPT.CODE$=STRING$(4,29)
  191.          EXIT SUB
  192.       END IF
  193.       CALL BUFFILE(FILE.NAME$)
  194.       SUBROUTINE.PARAMETER=1
  195.       A$="Enter Choices Separated by Semi-Colons or [A]bort"
  196.       CALL TGET
  197.       CALL ALLCAPS(B$(1))
  198.       IF B$(1)="A" OR B$(1)="" THEN EXIT SUB
  199.       IF Q>4 THEN Q=4
  200.       FOR ARYNUM=1 TO Q
  201.          CALL ALLCAPS(B$(ARYNUM))
  202.          USER.CLR$(ARYNUM)=CHR$(INSTR("RGYBMCW",B$(ARYNUM))+30)
  203.          IF ARYNUM=Q AND Q<4 THEN
  204.             FOR I=Q+1 TO 4
  205.                USER.CLR$(I)=USER.CLR$(ARYNUM)
  206.             NEXT I
  207.          END IF
  208.       NEXT ARYNUM
  209.       CLR.PROMPT.CODE$=USER.CLR$(1)+USER.CLR$(2)+USER.CLR$(3)+USER.CLR$(4)
  210.       END SUB                                                 'CPRMPT
  211.  
  212.  
  213.  - RBBSSUB2.BAS -
  214.  
  215.  - Field Definitions                    -
  216.  - Save User Color Options              -
  217.  - Set color to grey when user logs off -
  218.  
  219.  
  220. 10600 USER.FILE.INDEX = ORIG.USER.FILE.INDEX
  221.       CALL TIMEREMAIN (TIME.REMAINING!)
  222.       Q! = ELAPSED.TIME + _
  223.            ((SECONDS.PER.SESSION! - TIME.CREDITS!)/ 60) - _
  224.            TIME.REMAINING!
  225.       IF Q! < -32000 THEN _
  226.          Q! = -32000 _
  227.       ELSE IF Q! > 32000 THEN _
  228.          Q! = 32000
  229.       IF USER.FILE.INDEX < 1 THEN _
  230.          GOTO 10607
  231.       UPDATE.DEFAULTS = (ACTIVE.USER.FILE$ = ORIG.USER.FILE$)
  232.       ACTIVE.USER.FILE$ = ORIG.USER.FILE$
  233.       SUBROUTINE.PARAMETER = 6
  234.       CALL FILELOCK
  235.       CALL OPENUSER (HIGHEST.USER.RECORD)
  236.       FIELD 5,31 AS USER.NAME$, _
  237.               15 AS PASSWORD$, _
  238.                2 AS SECURITY.LEVEL$, _
  239.               14 AS USER.OPTIONS$,  _
  240.               24 AS CITY.STATE$, _
  241.               15 AS MACHINE.TYPE$, _                 'DGSCMOD
  242.                4 AS CLR.PRMPT.CODE$, _               'DGSC
  243.               14 AS LAST.DATE.TIME.ON$, _
  244.                3 AS LIST.NEW.DATE$, _
  245.                2 AS USER.DOWNLOADS$, _
  246.                2 AS USER.UPLOADS$, _
  247.                2 AS ELAPSED.TIME$
  248. 10604 GET 5,USER.FILE.INDEX
  249.       IF UPDATE.DEFAULTS THEN _
  250.          CALL DEFAULTU
  251.       IF LIST.DIRECTORY THEN _
  252.          LSET LIST.NEW.DATE$ = CHR$(VAL(MID$(CURRENT.DATE$,7,2))) + _
  253.                                CHR$(VAL(MID$(CURRENT.DATE$,1,2))) + _
  254.                                CHR$(VAL(MID$(CURRENT.DATE$,4,2)))
  255. 10605 LSET USER.DOWNLOADS$ = MKI$(DOWNLOADS)
  256.       LSET USER.UPLOADS$ = MKI$(UPLOADS)
  257.       LSET ELAPSED.TIME$ = MKI$(Q!)
  258.       LSET CLR.PRMPT.CODE$ = CLR.PROMPT.CODE$           'DGSC
  259.       IF ADJUSTED.SECURITY THEN _
  260.          LSET SECURITY.LEVEL$ = MKI$(USER.SECURITY.LEVEL)
  261.       PUT 5,USER.FILE.INDEX
  262. 10607 IF EXIT.TO.DOORS THEN _
  263.          EXIT SUB
  264.       IF MAX.PER.DAY <= 0 THEN _
  265.          X = MINUTES.PER.SESSION! _
  266.       ELSE X = (MAX.PER.DAY - Q!) : _
  267.            X = -(X > 0) * X
  268.       CALL QTPUT (STR$(X)+" min left for next call today",1)
  269.       CALL QTPUT(FIRST.NAME$ + ", Thanks and please call again!",1)
  270.       CALL QTPUT(CHR$(27)+"[0m",1)                       'DGSC
  271.       CALL DELAYIT (8 + BPS)
  272.       END SUB
  273.  
  274.  
  275.  
  276.  
  277.  - RBBS-VAR.BAS -
  278.  
  279. ' $SUBTITLE: 'Arrays passed between various components of RBBS-PC'
  280. ' $PAGE
  281.    DEFINT A-Z
  282. '
  283. ' The following static arrays are passed between the various subroutines
  284. ' within RBBS-PC.
  285. '
  286.     DIM USER.CLR(4)                   ' Integer ANSI Equivalent   'DGSC
  287.     DIM USER.CLR$(4)                  ' ANSI Color Sequence       'DGSC
  288.     DIM COM.PORT.ADDRESS(7)           ' COM Port Hardware Addresses
  289.     DIM HELP$(9)                      ' Help file names
  290.     DIM LG$(12)                       ' 12 Work variables.
  291.     DIM MENU$(7)                      ' Menu file names
  292.     DIM SUBDIR$(99)                   ' Download Sub-Dirs 'NCR      'TF040301
  293.  
  294.  
  295.  
  296.           CN$, _
  297.           CLR.PROMPT.CODE$, _                           'DGSC
  298.           COM.PORT.ADDRESS(), _
  299.  
  300.           USER.BLOCK.LOCK, _
  301.           USER.CLR(), _                                 'DGSC
  302.           USER.CLR$(), _                                'DGSC
  303.           USER.DOWNLOADS$, _
  304.  
  305.           USER.OPTIONS$, _
  306.           USER.PROMPT.CODE$, _                  'DGSC
  307.           USER.RECORD$, _
  308.